﻿/// /////////////////////////////////////////////
// 单元名 : ShareAndDLForm
// 作者 : Hawk
// 单元描述 :
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit ShareAndDLForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, MsgBaseForm, ComCtrls, StdCtrls,
  Buttons, unitCommonDataStruct, unitFileAndTransCommon, unitClientBUffer, unitDataCenter, unitShareFileObjs,
  unitMsgObj, ExtCtrls, frameDLItem, Mask, unitUniqueDataCommon, unitCommonTypes,
  ImageList, Vcl.ImgList;

type
  TfrmMBShareAndDL = class(TfrmMsgBase)
    pcMain: TPageControl;
    tsLocalShare: TTabSheet;
    tsDLMng: TTabSheet;
    Label1: TLabel;
    gbNewShare: TGroupBox;
    btnDelShare: TBitBtn;
    tvNewShare: TTreeView;
    btnNewPack: TBitBtn;
    btnNewFile: TBitBtn;
    btnCommit: TBitBtn;
    btnDelNewShare: TBitBtn;
    btnAddPath: TBitBtn;
    btnCopyDL: TBitBtn;
    btnNewDL: TBitBtn;
    btnCopyLinkDL: TBitBtn;
    pnlDownloading: TPanel;
    lvShareList: TListView;
    bAddLowerPath: TBitBtn;
    leSearch: TLabeledEdit;
    ImageList1: TImageList;
    procedure btnNewPackClick(Sender: TObject);
    procedure btnNewFileClick(Sender: TObject);
    procedure btnDelNewShareClick(Sender: TObject);
    procedure btnCommitClick(Sender: TObject);
    procedure btnAddPathClick(Sender: TObject);
    procedure btnDelShareClick(Sender: TObject);
    procedure btnCopyDLClick(Sender: TObject);
    procedure btnNewDLClick(Sender: TObject);
    procedure bAddLowerPathClick(Sender: TObject);
    procedure leSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FShareTbl: TClientObjList;
    // FRootFileInfoTbl: TClientObjList;
    FLastPath: string;

    function FindDLItemInUI(id: TDownloadItem): TfrDownloadItem;
    procedure DelDLClick(Sender: TObject);
    procedure RescureMapFile(so: TShareObj);
    procedure UpdateShareStubFillLV(li: TListItem; obj: TSerialObj);
    procedure AdjustDLFramePos;
    procedure ProcAddDLResp(msg: TMsg);
    procedure StringObjSyncTV(tv: TTreeView; so: TStringObj; tn: TTreeNode);
    procedure ShareObjUpdated(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure FileInfoUpdated(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure DLItemUpdated(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure DLItemDeled(Sender: TObject; obj: TSerialObj; const sid, uid: TID_OBJ);
  protected
    procedure DoProcMsg(msg: TMsg); override;
  public
    { Public declarations }
    procedure FuncStart; override;
    procedure FuncStop; override;
    procedure TableRecved(const RemoteHost: TID_HOST; tbl: TClientObjList); override;
  end;

implementation

uses clipbrd, unitObjPool, unitWinAPI, unitMisc, NewDLDlg, unitErrCodeDef, unitClassIDDef, unitPYIndex;

{$R *.dfm}

procedure TfrmMBShareAndDL.AdjustDLFramePos;
var
  t: integer;
  i: integer;
begin
  t := 2;
  for i := 0 to pnlDownloading.ControlCount - 1 do
  begin
    pnlDownloading.Controls[i].Top := t;
    pnlDownloading.Controls[i].Width := pnlDownloading.Width - 4;
    Inc(t, pnlDownloading.Controls[i].Height);
  end;
end;

procedure TfrmMBShareAndDL.bAddLowerPathClick(Sender: TObject);
var
  s: string;
  so, so1: TStringObj;
begin
  s := SelectFolder(Handle, '');
  if s <> '' then
  begin
    so := EnumPath(s, True);
    so1 := TStringObj(so.Item[0]);
    while so1 <> nil do
    begin
      so1.Str := ExtractFileName(so1.Str);
      StringObjSyncTV(tvNewShare, so1, nil);
      so1 := TStringObj(so1.Next);
    end;
  end;
end;

procedure TfrmMBShareAndDL.btnAddPathClick(Sender: TObject);
var
  s: string;
  so: TStringObj;
  csa: TCommStrArr;
  i: integer;
begin
  if PeerHost = Self.LocalID.IDDetail.SvrMdl.HostID then
  begin
    s := SelectFolder(Handle, '');
    if s <> '' then
    begin
      so := EnumPath(s, True);
      so.Str := ExtractFileName(so.Str);
      StringObjSyncTV(tvNewShare, so, nil);
    end;
  end
  else
  begin
    csa := GetHostFilesDlg(Self, False);
    for i := 0 to High(csa) do
      tvNewShare.Items.AddChild(tvNewShare.Selected, csa[i]);
  end;
end;

procedure TfrmMBShareAndDL.btnCommitClick(Sender: TObject);
var
  tn: TTreeNode;
  so: TStringObj;
  p: TSerialObj;
  m: TMsg;
  i: integer;

  procedure Rescure(ttn: TTreeNode; ss: TStringObj);
  var
    j: integer;
    tmp: TTreeNode;
    ssss: TStringObj;
  begin
    for j := 0 to ttn.Count - 1 do
    begin
      tmp := ttn.Item[j];
      ssss := ObjPool.GetObj(TStringObj, Self);
      ssss.Str := tmp.Text;
      ss.AddObj(ssss);
      Rescure(tmp, ssss);
    end;
  end;

begin
  if tvNewShare.Items.Count > 0 then
  begin
    m := GetMsg;
    if LocalID.IDDetail.SvrMdl.HostID = PeerHost then
    begin
      m.TargetObjID := OBJID_FILEANDTRANSMODULE;
      m.MsgID := MESID_FILETRANS_ADDLOCALSHAREOBJ;
      p := m;
    end
    else
    begin
      m.TargetObjID := MakeObjID(PeerHost, UNIQUEDATAMODULE_ID);
      m.MsgID := MESID_UNIQUEDATA_ADDOBJ;
      p := m.AddIDObj(ID_SHAREOBJTABLE);
    end;
    for i := 0 to tvNewShare.Items.Count - 1 do
      if tvNewShare.Items.Item[i].Level = 0 then
      begin
        tn := tvNewShare.Items.Item[i];
        so := ObjPool.GetObj(TStringObj, Self);
        so.Str := tn.Text;
        Rescure(tn, so);
        p.AddObj(so);
      end;
    SendMsg(m);
    tvNewShare.Items.Clear;
  end;
end;

procedure TfrmMBShareAndDL.btnCopyDLClick(Sender: TObject);
var
  o: TSerialObj;
  s: string;
  i: integer;
begin
  s := '';
  for i := 0 to lvShareList.Items.Count - 1 do
    if lvShareList.Items.Item[i].Selected then
    begin
      o := lvShareList.Items.Item[i].Data;
      if o <> nil then
        s := s + #13 + o.ObjID.ToString;
    end;
  Delete(s, 1, 1);
  if s <> '' then
    Clipboard.AsText := s;
end;

procedure TfrmMBShareAndDL.btnDelNewShareClick(Sender: TObject);
var
  i, l: integer;
  sels: array of integer;
begin
  l := 0;
  for i := 0 to tvNewShare.Items.Count - 1 do
    if tvNewShare.Items.Item[i].Selected then
    begin
      SetLength(sels, l + 1);
      sels[l] := i;
      Inc(l);
    end;
  for i := High(sels) downto Low(sels) do
    tvNewShare.Items.Delete(tvNewShare.Items.Item[sels[i]]);
end;

procedure TfrmMBShareAndDL.btnDelShareClick(Sender: TObject);
begin
  ExecDelObjProcess(lvShareList, PeerHost);//, ID_SHAREOBJTABLE);
end;

procedure TfrmMBShareAndDL.btnNewDLClick(Sender: TObject);
var
  id: TID_OBJ;
  d: TdlgNewDL;
  so: TStringObj;
  i: integer;
begin
  d := TdlgNewDL.Create(Application);
  d.eSavePath.Text := FLastPath;
  if d.ShowModal = mrOK then
    for i := 0 to d.mDLLinks.Lines.Count - 1 do
    begin
      id.FromStr(Trim(d.mDLLinks.Lines.Strings[i]));
      if not id.IsEmpty then
      begin
        so := ObjPool.GetObj(TStringObj, Self);
        so.ObjID := id;
        so.Str := Trim(d.eSavePath.Text);
        so.flag := I_DL_FORCEADDDL or I_DL_NOTCHECKFILE;
        AddRecord(PeerHost, ID_DOWNLOADINGTABLE, so);
      end;
    end;
  d.Free;
end;

procedure TfrmMBShareAndDL.btnNewFileClick(Sender: TObject);
var
  i: integer;
  csa: TCommStrArr;
begin
  if PeerHost = LocalID.IDDetail.SvrMdl.HostID then
  begin
    if OpenDialog.Execute(Handle) then
    begin
      for i := 0 to OpenDialog.Files.Count - 1 do
        tvNewShare.Items.AddChild(tvNewShare.Selected, OpenDialog.Files.Strings[i]);
      tvNewShare.FullExpand;
    end;
  end
  else
  begin
    csa := GetHostFilesDlg(Self, False);
    for i := 0 to High(csa) do
      tvNewShare.Items.AddChild(tvNewShare.Selected, csa[i]);
  end;
end;

procedure TfrmMBShareAndDL.btnNewPackClick(Sender: TObject);
var
  s: string;
  tn: TTreeNode;
begin
  s := Trim(InputBox('新增包', '请输入包名称', ''));
  if s <> '' then
  begin
    tn := tvNewShare.Items.AddChild(tvNewShare.Selected, s);
    tn.Selected := True;
  end;
end;

procedure TfrmMBShareAndDL.DelDLClick(Sender: TObject);
var
  fr: TfrDownloadItem;
begin
  fr := TfrDownloadItem(TWinControl(TWinControl(Sender).Parent).Parent);
  if fr <> nil then
    DelRecord(PeerHost, [fr.DLID]);
end;

procedure TfrmMBShareAndDL.DLItemDeled(Sender: TObject; obj: TSerialObj; const sid, uid: TID_OBJ);
var
  dl: TDownloadItem absolute obj;
  ui: TfrDownloadItem;
begin
  ui := FindDLItemInUI(dl);
  if ui <> nil then
  begin
    ui.Free;
    AdjustDLFramePos;
  end;
end;

procedure TfrmMBShareAndDL.DLItemUpdated(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
var
  dl: TDownloadItem absolute obj;
  ui: TfrDownloadItem;
begin
  ui := FindDLItemInUI(dl);
  if ui = nil then
  begin
    ui := TfrDownloadItem.Create(pnlDownloading);
    ui.Name := 'DLFrame_' + IntToHex(NativeUInt(ui));
    ui.Left := 2;
    ui.Width := pnlDownloading.Width - 4;
    ui.Parent := pnlDownloading;
    AdjustDLFramePos;
    ui.Anchors := [akLeft, akTop, akRight];
    ui.bDelDL.OnClick := DelDLClick;
  end;
  ui.SetDLItem(dl);
end;

procedure TfrmMBShareAndDL.DoProcMsg(msg: TMsg);
begin
  inherited;
end;

procedure TfrmMBShareAndDL.FileInfoUpdated(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
var
  fi: TShareFileObj absolute obj;
  so: TShareObj;
begin
  so := TShareObj(FShareTbl.Item[0]);
  RescureMapFile(so);
end;

function TfrmMBShareAndDL.FindDLItemInUI(id: TDownloadItem): TfrDownloadItem;
var
  i: integer;
  fr: TfrDownloadItem;
begin
  Result := nil;
  for i := 0 to pnlDownloading.ControlCount - 1 do
  begin
    fr := TfrDownloadItem(pnlDownloading.Controls[i]);
    if (fr.DLID = id.ObjID) then
    begin
      Result := fr;
      Break;
    end;
  end;
end;

procedure TfrmMBShareAndDL.FormResize(Sender: TObject);
begin
  AdjustDLFramePos;
end;

procedure TfrmMBShareAndDL.FuncStart;
begin
  inherited;
  AddBindInfo(ID_SHAREOBJTABLE, PeerHost, lvShareList, TSharePack, nil, nil, UpdateShareStubFillLV, nil,
    ShareObjUpdated, nil);
  AddBindInfo(ID_SHAREOBJTABLE, PeerHost, lvShareList, TShareFileStub, nil, nil, UpdateShareStubFillLV, nil, nil, nil);
  AddBindInfo(ID_DOWNLOADINGTABLE, PeerHost, nil, nil, nil, nil, nil, nil, DLItemUpdated, DLItemDeled);
end;

procedure TfrmMBShareAndDL.FuncStop;
begin
  inherited;
end;

procedure TfrmMBShareAndDL.leSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  s: string;
  sp: string;
  i: integer;
  li: TListItem;
begin
  if Key = VK_RETURN then
  begin
    s := Trim(leSearch.Text);
    if s <> '' then
    begin
      for i := 0 to lvShareList.Items.Count - 1 do
      begin
        li := lvShareList.Items.Item[i];
        sp := GetPYIndex(AnsiString(li.Caption));
        li.Selected := (Pos(s, li.Caption) <> 0) or (Pos(s, sp) <> 0);
      end;
    end;
  end;
end;

procedure TfrmMBShareAndDL.ProcAddDLResp(msg: TMsg);
var
  s: string;
  tmp: TDownloadItem;
  m: TMsg;
begin
  if msg.Error <> ERRCODE_NOERROR then
  begin
    s := Format('新增下载时候发现错误：%s'#10'请确认是否强制下载。', [ErrCodeToStr(msg.Error)]);
    if MessageBox(Handle, PWideChar(s), '确认', MB_YESNO or MB_ICONQUESTION) = ID_YES then
    begin
      tmp := msg.Param(TDownloadItem);
      m := GetMsg;
      m.TargetObjID := OBJID_FILEANDTRANSMODULE;
      m.AddIDObj(tmp.ShareObjID, FLastPath);
      m.Data := 1;
      SendMsg(m);
    end;
  end;
end;

procedure TfrmMBShareAndDL.RescureMapFile(so: TShareObj);
var
  tmp: TShareObj;
begin
  if so <> nil then
    case so.ClassID of
      CLASSID_DATATABLE, CLASSID_SHAREPACKOBJ:
        begin
          tmp := TShareObj(so.Item[0]);
          while tmp <> nil do
          begin
            RescureMapFile(tmp);
            tmp := TShareObj(tmp.Next);
          end;
        end;
      CLASSID_SHAREFILESTUB:
        begin
          // fi := TShareFileObj(FRootFileInfoTbl.FindItemLowerLevel(TID_OBJ(TShareFileStub(so).FileHash)));
          // if fi <> nil then
          // TShareFileStub(so).RealFileObj := fi
          // else
          // FetchTblRecord(HOSTID_ROOT, ID_FILEINFOTABLE, TID_OBJ(TShareFileStub(so).FileHash));
        end;
    end;
end;

procedure TfrmMBShareAndDL.ShareObjUpdated(Sender: TObject; ParObj, obj: TSerialObj; const sid, uid: TID_OBJ);
var
  so: TShareObj absolute obj;
begin
  RescureMapFile(so);
  // FLocalShareTbl.FreshUI;
end;

procedure TfrmMBShareAndDL.StringObjSyncTV(tv: TTreeView; so: TStringObj; tn: TTreeNode);
var
  ttmp: TTreeNode;
  tso: TStringObj;
begin
  ttmp := tv.Items.AddChild(tn, so.Str);
  ttmp.Data := so;
  so.Data := ttmp;
  tso := TStringObj(so.Item[0]);
  while tso <> nil do
  begin
    StringObjSyncTV(tv, tso, ttmp);
    tso := TStringObj(tso.Next);
  end;
end;

procedure TfrmMBShareAndDL.TableRecved(const RemoteHost: TID_HOST; tbl: TClientObjList);
begin
  if tbl.ObjID = ID_SHAREOBJTABLE then
    FShareTbl := tbl;
  inherited;
end;

procedure TfrmMBShareAndDL.UpdateShareStubFillLV(li: TListItem; obj: TSerialObj);
var
  sp: TSharePack absolute obj;
  sft: TShareFileStub absolute obj;
begin
  li.Indent := obj.Level - 1;
  li.Caption := obj.Caption;
  li.SubItems.Add(sp.Creator.ToString);
  li.SubItems.Add(DateTimeToStr(sp.CreatTime));
  li.SubItems.Add(SizeToStr(sp.AllSize.fp64));
  li.SubItems.Add(SizeToStr(sp.LocalStore.fp64));
  case obj.ClassID of
    CLASSID_SHAREPACKOBJ:
      ;
    CLASSID_SHAREFILESTUB:
      if sft.Status in [sfsNone .. sfsHashFail] then
        li.SubItems.Add(S_SHAREFILESTATUS[sft.Status])
      else
        li.SubItems.Add(S_ERRORSTATUS + IntToStr(integer(sft.Status)));
  end;
end;

initialization

RegFuncClass(HOSTID_ALLMASK, '共享和下载管理', '提供共享配置和下载管理界面', TfrmMBShareAndDL);

end.
